home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / Bonus / Plasmatech / ptscp_examples.exe / %MAINDIR% / Examples / NetworkTree / Delphi / FMain.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2001-08-31  |  2.2 KB  |  92 lines
  1. unit FMain;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   ShlObj, Menus, StdCtrls, ComCtrls,
  8.   UPTShellUtils, UPTFrame, UPTTreeList, UPTShellControls;
  9.  
  10. type
  11.   TFrmMain = class(TForm)
  12.     MainMenu1: TMainMenu;
  13.     File1: TMenuItem;
  14.     Exit1: TMenuItem;
  15.     PTShellTree1: TPTShellTree;
  16.     PTFrame1: TPTFrame;
  17.     Label1: TLabel;
  18.     CompLabel: TPTGroup;
  19.     Label2: TLabel;
  20.     procedure FormCreate(Sender: TObject);
  21.     procedure Exit1Click(Sender: TObject);
  22.     procedure PTShellTree1Change(Sender: TObject; Node: TTreeNode);
  23.   private
  24.     FComputerIndex: Integer;
  25.     procedure SetFrameText( aName: String );
  26.   public
  27.     { Public declarations }
  28.   end;
  29.  
  30. var
  31.   FrmMain: TFrmMain;
  32.  
  33. implementation
  34.  
  35. {$R *.DFM}
  36.  
  37. {
  38.  The technique used to determine which nodes are "Computer" nodes is find which image is
  39.  used for computers and simple check a node's image against that value. It should be
  40.  possible to use the SHGetDataFromIDList function to check what type a node is, but
  41.  that function seems very unreliable.
  42. }
  43. procedure TFrmMain.FormCreate(Sender: TObject);
  44. var sz: array[0..MAX_COMPUTERNAME_LENGTH] of Char;
  45.     siz: DWORD;
  46. begin
  47.   try
  48.     siz := Sizeof(sz);
  49.     Windows.GetComputerName( @sz[0], siz );
  50.     if Length(sz) <= 0 then
  51.       raise Exception.Create( 'This computer is not present on the network.' );
  52.     FComputerIndex := ShellGetIconIndexFromPath('\\'+sz,0);
  53.   except
  54.     on e: Exception do
  55.     begin
  56.       Application.ShowMainForm := FALSE;
  57.       Application.HandleException(e);
  58.       Application.Terminate;
  59.     end;
  60.   end;
  61. end;
  62.  
  63. procedure TFrmMain.PTShellTree1Change(Sender: TObject; Node: TTreeNode);
  64. begin
  65.   if Node.ImageIndex = FComputerIndex then
  66.     SetFrameText( Node.Text )
  67.   else
  68.     SetFrameText( '' );
  69. end;
  70.  
  71. procedure TFrmMain.SetFrameText( aName: String );
  72. begin
  73.   if aName='' then
  74.   begin
  75.     CompLabel.Caption := '<Not a computer>';
  76.     CompLabel.Color := clRed;
  77.   end
  78.   else
  79.   begin
  80.     CompLabel.Caption := aName;
  81.     CompLabel.Color := clGreen;
  82.   end;
  83. end;
  84.  
  85. procedure TFrmMain.Exit1Click(Sender: TObject);
  86. begin
  87.   Close;
  88. end;
  89.  
  90. end.
  91.  
  92.